home *** CD-ROM | disk | FTP | other *** search
/ CrystalVision Software Se… Wiki Wonder - Wikipedia / CrystalVision Software Services 703: The Wiki Wonder - Wikipedia.iso / 0703 / Educate / Complete Calc / Setup.exe / lib / tcl / history.tcl < prev    next >
Encoding:
Text File  |  2006-10-25  |  5.0 KB  |  251 lines
  1.  
  2.  
  3. namespace eval tcl {
  4. variable history
  5. if {![info exists history]} {
  6. array set history {
  7. nextid    0
  8. keep    20
  9. oldest    -20
  10. }
  11. }
  12. }
  13.  
  14.  
  15. proc history {args} {
  16. set len [llength $args]
  17. if {$len == 0} {
  18. return [tcl::HistInfo]
  19. }
  20. set key [lindex $args 0]
  21. set options "add, change, clear, event, info, keep, nextid, or redo"
  22. switch -glob -- $key {
  23. a* { # history add
  24.  
  25. if {$len > 3} {
  26. return -code error "wrong # args: should be \"history add event ?exec?\""
  27. }
  28. if {![string match $key* add]} {
  29. return -code error "bad option \"$key\": must be $options"
  30. }
  31. if {$len == 3} {
  32. set arg [lindex $args 2]
  33. if {! ([string match e* $arg] && [string match $arg* exec])} {
  34. return -code error "bad argument \"$arg\": should be \"exec\""
  35. }
  36. }
  37. return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]
  38. }
  39. ch* { # history change
  40.  
  41. if {($len > 3) || ($len < 2)} {
  42. return -code error "wrong # args: should be \"history change newValue ?event?\""
  43. }
  44. if {![string match $key* change]} {
  45. return -code error "bad option \"$key\": must be $options"
  46. }
  47. if {$len == 2} {
  48. set event 0
  49. } else {
  50. set event [lindex $args 2]
  51. }
  52.  
  53. return [tcl::HistChange [lindex $args 1] $event]
  54. }
  55. cl* { # history clear
  56.  
  57. if {($len > 1)} {
  58. return -code error "wrong # args: should be \"history clear\""
  59. }
  60. if {![string match $key* clear]} {
  61. return -code error "bad option \"$key\": must be $options"
  62. }
  63. return [tcl::HistClear]
  64. }
  65. e* { # history event
  66.  
  67. if {$len > 2} {
  68. return -code error "wrong # args: should be \"history event ?event?\""
  69. }
  70. if {![string match $key* event]} {
  71. return -code error "bad option \"$key\": must be $options"
  72. }
  73. if {$len == 1} {
  74. set event -1
  75. } else {
  76. set event [lindex $args 1]
  77. }
  78. return [tcl::HistEvent $event]
  79. }
  80. i* { # history info
  81.  
  82. if {$len > 2} {
  83. return -code error "wrong # args: should be \"history info ?count?\""
  84. }
  85. if {![string match $key* info]} {
  86. return -code error "bad option \"$key\": must be $options"
  87. }
  88. return [tcl::HistInfo [lindex $args 1]]
  89. }
  90. k* { # history keep
  91.  
  92. if {$len > 2} {
  93. return -code error "wrong # args: should be \"history keep ?count?\""
  94. }
  95. if {$len == 1} {
  96. return [tcl::HistKeep]
  97. } else {
  98. set limit [lindex $args 1]
  99. if {[catch {expr {~$limit}}] || ($limit < 0)} {
  100. return -code error "illegal keep count \"$limit\""
  101. }
  102. return [tcl::HistKeep $limit]
  103. }
  104. }
  105. n* { # history nextid
  106.  
  107. if {$len > 1} {
  108. return -code error "wrong # args: should be \"history nextid\""
  109. }
  110. if {![string match $key* nextid]} {
  111. return -code error "bad option \"$key\": must be $options"
  112. }
  113. return [expr {$tcl::history(nextid) + 1}]
  114. }
  115. r* { # history redo
  116.  
  117. if {$len > 2} {
  118. return -code error "wrong # args: should be \"history redo ?event?\""
  119. }
  120. if {![string match $key* redo]} {
  121. return -code error "bad option \"$key\": must be $options"
  122. }
  123. return [tcl::HistRedo [lindex $args 1]]
  124. }
  125. default {
  126. return -code error "bad option \"$key\": must be $options"
  127. }
  128. }
  129. }
  130.  
  131.  
  132. proc tcl::HistAdd {command {exec {}}} {
  133. variable history
  134.  
  135. if {[string trim $command] eq ""} {
  136. return ""
  137. }
  138.  
  139. set i [incr history(nextid)]
  140. set history($i) $command
  141. set j [incr history(oldest)]
  142. unset -nocomplain history($j)
  143. if {[string match e* $exec]} {
  144. return [uplevel #0 $command]
  145. } else {
  146. return {}
  147. }
  148. }
  149.  
  150.  
  151. proc tcl::HistKeep {{limit {}}} {
  152. variable history
  153. if {$limit eq ""} {
  154. return $history(keep)
  155. } else {
  156. set oldold $history(oldest)
  157. set history(oldest) [expr {$history(nextid) - $limit}]
  158. for {} {$oldold <= $history(oldest)} {incr oldold} {
  159. unset -nocomplain history($oldold)
  160. }
  161. set history(keep) $limit
  162. }
  163. }
  164.  
  165.  
  166. proc tcl::HistClear {} {
  167. variable history
  168. set keep $history(keep)
  169. unset history
  170. array set history [list  nextid    0     keep    $keep     oldest    -$keep     ]
  171. }
  172.  
  173.  
  174. proc tcl::HistInfo {{num {}}} {
  175. variable history
  176. if {$num eq ""} {
  177. set num [expr {$history(keep) + 1}]
  178. }
  179. set result {}
  180. set newline ""
  181. for {set i [expr {$history(nextid) - $num + 1}]}  {$i <= $history(nextid)} {incr i} {
  182. if {![info exists history($i)]} {
  183. continue
  184. }
  185. set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
  186. append result $newline[format "%6d  %s" $i $cmd]
  187. set newline \n
  188. }
  189. return $result
  190. }
  191.  
  192.  
  193. proc tcl::HistRedo {{event -1}} {
  194. variable history
  195. if {$event eq ""} {
  196. set event -1
  197. }
  198. set i [HistIndex $event]
  199. if {$i == $history(nextid)} {
  200. return -code error "cannot redo the current event"
  201. }
  202. set cmd $history($i)
  203. HistChange $cmd 0
  204. uplevel #0 $cmd
  205. }
  206.  
  207.  
  208. proc tcl::HistIndex {event} {
  209. variable history
  210. if {[catch {expr {~$event}}]} {
  211. for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]}  {incr i -1} {
  212. if {[string match $event* $history($i)]} {
  213. return $i;
  214. }
  215. if {[string match $event $history($i)]} {
  216. return $i;
  217. }
  218. }
  219. return -code error "no event matches \"$event\""
  220. } elseif {$event <= 0} {
  221. set i [expr {$history(nextid) + $event}]
  222. } else {
  223. set i $event
  224. }
  225. if {$i <= $history(oldest)} {
  226. return -code error "event \"$event\" is too far in the past"
  227. }
  228. if {$i > $history(nextid)} {
  229. return -code error "event \"$event\" hasn't occured yet"
  230. }
  231. return $i
  232. }
  233.  
  234.  
  235. proc tcl::HistEvent {event} {
  236. variable history
  237. set i [HistIndex $event]
  238. if {[info exists history($i)]} {
  239. return [string trimright $history($i) \ \n]
  240. } else {
  241. return "";
  242. }
  243. }
  244.  
  245.  
  246. proc tcl::HistChange {cmd {event 0}} {
  247. variable history
  248. set i [HistIndex $event]
  249. set history($i) $cmd
  250. }
  251.